#lang rosetta-racket


(provide atomium)


(define (atomium-spheres r cs)
  (map (λ (p) (sphere p r)) cs))

(define (atomium-tubes r c cs1 cs2)
  (append
   (map
    (λ (pa pb) (cylinder pa r pb))
    cs1
    (list-rotate-left cs1 1))
   (map
    (λ (pa pb) (cylinder pa r pb))
    cs2
    (list-rotate-left cs2 1))
   (map
    (λ (pa pb) (cylinder pa r pb))
    cs1
    cs2)
   (flatten
    (map
     (λ (pa pb) (list (cylinder pa r c) (cylinder c r pb)))
     cs1
     (list-rotate-left cs2 2)))))

(define (atomium-frame sphere-r frame-w tube-r)
  (let ((c1 u0)
        (c2 (xyz (- frame-w) (- frame-w) (- frame-w)))
        (c3 (xyz (+ frame-w) (- frame-w) (- frame-w)))
        (c4 (xyz (+ frame-w) (+ frame-w) (- frame-w)))
        (c5 (xyz (- frame-w) (+ frame-w) (- frame-w)))
        (c6 (xyz (- frame-w) (- frame-w) (+ frame-w)))
        (c7 (xyz (+ frame-w) (- frame-w) (+ frame-w)))
        (c8 (xyz (+ frame-w) (+ frame-w) (+ frame-w)))
        (c9 (xyz (- frame-w) (+ frame-w) (+ frame-w))))
    (let ((cs1 (list c2 c3 c4 c5))
          (cs2 (list c6 c7 c8 c9)))
      (append
       (atomium-spheres sphere-r (cons c1 (append cs1 cs2)))
       (atomium-tubes tube-r c1 cs1 cs2)))))

(define (atomium sphere-r frame-w tube-r)
  (map (cλ rotate uz uxyz) (atomium-frame sphere-r frame-w tube-r)))